@create $feature named scheduler:scheduler

Replace #xxx with the object number returned by the line above.

@prop #xxx."lock" 1162877150 rc
@prop #xxx."task" 2101986977 rc
@prop #xxx."lock_timeout" 300 rc
@prop #xxx."tasks" {} rc
@prop #xxx."clearing" 0 rc
@prop #xxx."dump_interval" 10800 rc
@prop #xxx."dump_task" 0 rc
@prop #xxx."checkpoint_sizes" {} rc
@prop #xxx."checkpoint_times" {} rc
;;#xxx.("help_msg") = {"Scheduler:  The scheduler is designed as a process storage chamber.  Verbs which execute with a long period (an hour, a day, etc.) can be stored on the scheduler, without filling up the queued task list.  Verbs which need to happen with a certain number of iterations, or infinitely, can be handled by code in the scheduler, reducing the burden on the programmer.  The scheduler also accounts for drift in lag, allowing a verb to run at a certain time, every time.", "", "Building Blocks:", "", ":schedule       (rel_time,obj,verb[,args])", ":schedule_at    (abs_time,obj,verb[,args])", ":schedule_every (rel_time,obj,verb[,args])", "", "  \"rel_time\" indicates a time interval from the present moment, that is: a", " relative time, or \"x seconds from now\"", "  \"abs_time\" indicates an absolute time, for example: 749069038", "  \"obj\" indicates the object on which the verb you will call resides", "  \"verb\" is the verb you will be calling", "  \"args\" is/are the argument(s) you will use in the verb call.", "", "  The \"rel_time\" is a number, given in seconds.  The \"obj\" is an object", " number, like #1, the verb is a string, like \"tell\".  The \"args\" is a list of", " arguments to be passed, and may be left off.  If left off, no arguments will", " be passed.", "", "Examples:", "", ":schedule(35,#11,\"announce_all\",{\"I am here!\"})", "   which is equivalent to:", "   ;fork(35) #11:announce_all(\"I am here!\"); endfork", "", ":schedule_at(749069497,$fountain,\"start\")", "   equals:", "   ;fork(time()+6*24*3600) $fountain:start(); endfork", "", ":schedule_every(15,$puppet,\"action\",{\"move\",\"eat\",\"walk\"})", "   is fairly close in meaning to:", "   [verb code on $puppet]", "      ...", "   fork (15)", "     this:(verb)(\"move\",\"eat\",\"walk\");", "   endfork", "", "", "Extra Neat-o's:", "", "The \"object\" parameter in the verb calls above may be substituted with strings.  The string will then be passed to the player's eval_cmd_str(), and must return an object number.  If the code does not return a valid object number, the scheduled verb will not run.", "", "Also, the \"arguments\" parameter may be left as a simple value (integer, string, whatever), or left off entirely.", "", "Examples:", "", ":schedule_every(35,\"player.location\",\"announce_all\",{\"I am here!\"})", "  Every 35 seconds, this verb will announce to the player's current location.", "", ":schedule(35,\"player\",\"tell\",\"Hello from me!\")", "  Equivalent to :schedule(35,\"player\",\"tell\",{\"Hello from me!\"})", "", ":schedule(35,\"player\",\"tell\")", "  Equivalent to :schedule(35,\"player\",\"tell\",{})", "", "", "Problems:", "", "This is a simplified version of Pascal's scheduler put together by Changeling (geocorona@aol.com). Contact that address with problems.", "Original author: (t_pascal@oxy.edu).", "", "FOR SERVERS COMPILED WITHOUT AUTOMATIC CHECKPOINTING:", ";$scheduler:schedule($scheduler.dump_interval, $scheduler, \"do_checkpoint\")", "====================================================="}
;;#xxx.("feature_verbs") = {"@sched", "@unsched", "@reset", "@list-ch"}
;;#xxx.("icon") = "thing.gif"
;;#xxx.("banner") = ""
;;#xxx.("footer") = ""
;;#xxx.("external_stylesheet") = "encore_web_object.css"
;;#xxx.("hits") = 1
;;#xxx.("aliases") = {"scheduler"}
;;#xxx.("description") = "A feature object that can execute repetitive verbs, and verbs suspended for long periods."
;;#xxx.("object_size") = {23679, 1162627203}

@verb #xxx:"init_for_core" this none this
@program #xxx:init_for_core
if (($code_utils:verb_location() == this) && caller_perms().wizard)
  this.task = 0;
  this.clearing = 0;
  this.lock = 0;
  this.lock_timeout = 300;
  this.tasks = {};
  this.dump_interval = 10800;
  this.dump_task = 0;
  this.checkpoint_sizes = {};
  this.checkpoint_times = {};
endif
pass(@args);
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"add" this none this
@program #xxx:add
"  :add(time,t_id,data)  =>  inserts task on the task-list, in ascending order";
if ((caller != this) && (!caller_perms().wizard))
  return E_PERM;
endif
if (length(args) < 3)
  return E_ARGS;
elseif (!$recycler:valid(args[3][3]))
  return E_INVARG;
endif
time = tonum(args[1]);
i = 1;
len = length(tasks = this.tasks);
while ((i <= len) && (this.tasks[i][1] <= time))
  i = i + 1;
endwhile
this.tasks = listinsert(tasks, args, i);
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"insert" this none this
@program #xxx:insert
"  :insert(time,t_id,data)  =>  Updates tasks in the list, starting :atrun if necessary";
if ((caller != this) && (!caller_perms().wizard))
  return E_PERM;
endif
if (typeof(ret = this:add(@args)) == ERR)
  return ret;
endif
if (((tonum(args[1]) < this.lock) || (!(this.lock && this.task))) || (time() > (this.lock + this.lock_timeout)))
  this:stop_start();
endif
return ret;
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"assign" this none this
@program #xxx:assign
while ($list_utils:iassoc(n = random($maxint), this.tasks, 2))
  "Do nothing";
endwhile
"N is now unique..";
return n;
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"valid_task" this none this
@program #xxx:valid_task
"    :valid_task(taskid)  =>  true if taskid is in the current task-list";
return args ? $list_utils:iassoc(tonum(args[1]), this.tasks, 2) | E_ARGS;
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"usable_by" this none this
@program #xxx:usable_by
"    :usable_by(whom)  =>  1 | 0";
"This verb should return true if who has permission to use this";
if (args)
  return args[1].programmer;
else
  return E_ARGS;
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"kill_task*s" this none this
@program #xxx:kill_tasks
"  :kill_task*s(t_id[s])  =>  returns number of tasks killed";
if (!this:usable_by(caller_perms()))
  return E_PERM;
endif
if (args)
  t_ids = (typeof(args[1]) == LIST) ? args[1] | {args[1]};
  reset = 0;
  killed = 0;
  for t_id in (t_ids)
    if ((task = this:valid_task(tonum(t_id))) && $perm_utils:controls(caller_perms(), this.tasks[task][3][7]))
      this.tasks = listdelete(this.tasks, task);
      killed = killed + 1;
    endif
    reset = ((reset || task) == 1) ? 1 | 0;
  endfor
  if (reset)
    this:stop_start();
  endif
  return killed;
else
  return E_ARGS;
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"job_batch" this none this
@program #xxx:job_batch
"  :job_batch(time)  =>  returns a list of tasks due for time, taking them off the queue.";
if ((caller != this) && (!caller_perms().wizard))
  return E_PERM;
endif
if (args)
  time = tonum(args[1]);
  for x in [1..l = length(t = this.tasks)]
    if (t[x][1] > time)
      this.tasks = t[x..l];
      return t[1..x - 1];
    endif
  endfor
  this.tasks = {};
  return t;
else
  return E_ARGS;
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"do" this none this
@program #xxx:do
"Does the verb given args == {#obj,\"verb\",{args},#player,#permissions}";
"The #obj argument may be given as a string which is then eval()'d";
"This verb is a potential security hole!  Guard this one closely.";
if ((caller == this) && caller_perms().wizard)
  if (length(args) < 5)
    return E_ARGS;
  else
    player = args[4];
    set_task_perms(args[5]);
    if (typeof(object = args[1]) == STR)
      e = player:eval_cmd_string(object)[1..2];
      object = (e[1] && (typeof(e[2]) == OBJ)) ? e[2] | $nothing;
    endif
    `object:(args[2])(@args[3]) ! E_VERBNF => "object must be garbage now"';
  endif
else
  return $error:raise(E_PERM);
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"kill @unsched*ule" any none none rxd
@program #xxx:kill
"kill [task_id]";
"Unceremoniously kills the specified task. Wizards may also \"@unsched *\" (kill all tasks), or \"@unsched garbage\" (kill all tasks on recycled objects).";
if (!this:usable_by(player))
  player:tell("Permission denied.");
  return;
endif
n = length(dobjstr);
if (!n)
  player:tell("You must supply a task id to kill.");
  return;
endif
if ((dobjstr == "*") && player.wizard)
  if ($command_utils:yes_or_no("Kill all tasks?"))
    dobjstr = "&%&";
    n = 0;
  else
    player:tell("Kill aborted.");
    return;
  endif
elseif (dobjstr == "*")
  player:tell("Only administrators may kill all tasks.");
  return;
elseif ((dobjstr == "garbage") && player.wizard)
  ids = {};
  for task in (this.tasks)
    id = task[2];
    if ((parent(task[3][3]) == $garbage) || (!valid(task[3][3])))
      ids = listappend(ids, id);
    endif
  endfor
  killed = this:kill_tasks(ids);
  return player:tell("Killed ", tostr(killed), " task", (killed == 1) ? "." | "s.");
endif
ids = {};
for task in (this.tasks)
  id = task[2];
  if ((dobjstr in {tostr(id), "&%&"}) && $perm_utils:controls(player, task[3][7]))
    ids = listappend(ids, id);
  endif
endfor
killed = this:kill_tasks(ids);
player:tell("Killed ", tostr(killed), " task", (killed == 1) ? "." | "s.");
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"stop_start" this none this
@program #xxx:stop_start
"  :stop_start([seconds])  =>  Kill the old :atrun verb, and restart at the new time";
"   Optional arg for length of time until restart. Defaults to 0 seconds.";
if ((caller != this) && (!caller_perms().wizard))
  return E_PERM;
endif
`kill_task(this.task) ! E_INVARG';
this.clearing = 1;
delay = 0;
if (args)
  delay = toint(args[1]);
endif
fork (delay)
  this.clearing = 0;
  this:atrun();
endfork
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"atrun" this none this
@program #xxx:atrun
"The guts of the scheduler.  Handles jobs.";
if ((caller != this) && (!caller_perms().wizard))
  return E_PERM;
elseif (this.clearing)
  return "wait a few seconds for multiple atruns to clear. See this:stop_start.";
elseif ((this.task != task_id()) && (this.task in $list_utils:slice(queued_tasks())))
  kill_task(this.task);
endif
this.task = task_id();
this.lock = time = time();
for task in (this:job_batch(time))
  info = task[3];
  fork (0)
    this:do(@info[3..7]);
  endfork
  if ((freq = info[1]) > 1)
    freq = freq - 1;
  endif
  if (freq != 1)
    info[8][4] = time = time();
    this:insert((time + info[2]) - ((time - info[8][1]) % info[2]), task[2], info);
  endif
endfor
this.lock = (this.tasks && (time() < (this.lock + this.lock_timeout))) ? this.tasks[1][1] | 0;
if (this.lock)
  fork task (max(0, this.lock - time()))
    this:atrun();
  endfork
  this.task = task;
else
  this.task = 0;
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"look_self" this none this
@program #xxx:look_self
if (!this:usable_by(player))
  return 0;
endif
tasks = this.tasks;
if (tasks)
  su = $string_utils;
  player:tell("Job ID      Start Time            Player         Verb (* = forever)");
  player:tell(su:space(79, "-"));
  for task in (tasks)
    if ($perm_utils:controls(player, task[3][7]) || $perm_utils:controls(player, task[3][6]))
      temp = su:left(tostr(task[2]), 12, " ");
      temp = (temp + ctime(task[1])[5..24]) + "  ";
      temp = temp + su:left(task[3][6].name, 14, " ");
      if (task[3][1] < 1)
        temp = temp + "* ";
      endif
      temp = ((temp + tostr(task[3][3])) + ":") + task[3][4];
      temp = temp + su:print(task[3][5]);
      player:tell(temp);
    endif
  endfor
  player:tell(su:space(79, "-"));
else
  player:tell("No jobs scheduled on ", this.name, ".");
endif
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"get_task_display" this none this
@program #xxx:get_task_display
":get_task_display()";
"==> returns the output to be displayed by $scheduler:@sched.";
"Written by Firesong (#337)@Weyrmount";
su = $string_utils;
running = this:is_running();
line = su:space(79, "-");
header = {line};
header = {@header, "  Scheduler status       : " + tostr(running ? "The scheduler is currently running." | "The scheduler seems to have been stopped.")};
header = {@header, "  Current system time    : " + tostr(ctime())};
header = {@header, "  Tasks waiting in queue : " + tostr(length(this.tasks))};
string = su:space(max(5, 79 - length(string = "Task running in.."))) + string;
header = {@header, string};
header = {@header, line};
retval = {};
for task in ($scheduler.tasks)
  if ($perm_utils:controls(player, task[3][7]) || $perm_utils:controls(player, task[3][6]))
    next_fire = task[1];
    task_id = task[2];
    interations = task[3][1];
    interval = task[3][2];
    object = task[3][3];
    verb = task[3][4];
    vargs = task[3][5];
    owner = task[3][6];
    task_started = task[3][8][1];
    perms = task[3][8][3];
    last_fired = task[3][8][4];
    "...";
    varg_str = (varg_str = su:print(vargs))[2..length(varg_str) - 1];
    time_str = $time_utils:english_time(next_fire - time());
    line1 = ((((("Verb  : " + tostr(object)) + ":") + tostr(verb)) + "(") + varg_str) + ")";
    spaces = max(5, 79 - (length(line1) + length(time_str)));
    line1 = (line1 + su:space(spaces)) + time_str;
    perm_str = "Perms : " + tostr((perms == $no_one) ? "$NO_ONE" | su:nn(perms));
    task_str = "Task ID : " + tostr(task_id);
    spaces = max(1, 50 - length(perm_str));
    line2 = (perm_str + su:space(spaces)) + task_str;
    owner_str = "Player: " + su:nn(owner);
    spaces = max(1, 50 - length(owner_str));
    line3 = (owner_str + su:space(spaces)) + (interval ? ("Interval: " + tostr(interval)) + " seconds" | "Interval: Will not run again");
    retval = {@retval, line1, line2, line3, line};
    ((ticks_left() < 4000) || (seconds_left() < 2)) && suspend(5);
  endif
endfor
return {header, retval};
"Last modified Wed Jan  1 19:49:58 2003 UTC by Wizard (#2).";
.

@verb #xxx:"@sched*uler" none none none rxd
@program #xxx:@scheduler
":@sched*uler()   <-- A Feature Verb to diplay an alternate task list on the scheduler.";
"";
"Sample output:";
"";
"[SCHEDULER] Browse Mode";
"";
"The Scheduler is currently ticking away";
"  Tasks waiting in queue : 31";
"  Current system time    : Tue Apr  9 18:38:09 1996 HDT";
"";
"                                                                   Running in..";
"-------------------------------------------------------------------------------";
"Verb  : #280:DO_check_kids()                                          8 seconds";
"Perms : Firesong (#337)                           Task ID : 1300241341";
"Player: Firesong (#337)                           Interval: 60 seconds";
"-------------------------------------------------------------------------------";
"Done..";
"";
"Written by Firesong (#337)@Weyrmount";
info = this:get_task_display();
"...Display header info...";
player:tell_lines(info[1]);
"...Display task info...";
if (info[2])
  for line in (info[2])
    player:tell(line);
    ((ticks_left() < 4000) || (seconds_left() < 2)) && suspend(5);
  endfor
  player:tell("Done..");
elseif (player.wizard)
  player:tell("There are no tasks running on the scheduler.");
else
  player:tell("You don't have any tasks running on the scheduler.");
endif
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

@verb #xxx:"is_running" this none this
@program #xxx:is_running
":is_running()   <-- Called by :get_task_display";
"Returns:";
"  --> 0 The scheduler is not running (no valid task)";
"  --> 1 The scheduler's master firing task is currently running";
cu = $code_utils;
running = cu:task_valid(this.task);
return running;
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

@verb #xxx:"@reset" this any any
@program #xxx:@reset
"@reset <scheduler> [in <seconds>] => stops scheduler, the restarts it in so many seconds. Default is 5 seconds.";
if (!player.wizard)
  player:tell("Permission denied.  Contact an administrator.");
  return;
endif
delay = 5;
if (iobjstr)
  delay = toint(iobjstr);
endif
player:tell("Resetting in ", delay, " seconds.");
for task in (queued_tasks())
  if (task[7] == "atrun")
    kill_task(task[1]);
  endif
endfor
this:stop_start(delay);
fork (delay)
  player:tell("Done.");
endfork
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

@verb #xxx:"schedule schedule_at schedule_every" this none this
@program #xxx:schedule
"  :schedule(interval,object,\"verb\"[,{[arguments]}[,player[,perms]])]";
"  :schedule_at(time,object,\"verb\"[,{[arguments]}[,player[,perms]])]";
"  :schedule_every(interval,object,\"verb\"[,{[arguments]}[,player[,perms]])]";
"Schedules an event guarenteed to occur sometime after the interval has expired.  Returns a psuedo task id suitable for :kill_task() if successful, error otherwise.  Remember, the scheduler will try to adjust for drift.";
"Example:  (at the end of a verb) fork (300) this:(verb)(x,y,z); endfork";
"Becomes:  (outside the verb, probably from eval) :schedule_every(300,this,verb,{x,y,z})";
if (!this:usable_by(caller_perms()))
  return E_PERM;
elseif ((len = length(args)) < 3)
  return E_ARGS;
elseif ((verb == "schedule_at") && (time() > args[1]))
  return E_INVARG;
endif
vargs = (len > 3) ? (typeof(args[4]) == LIST) ? args[4] | {args[4]} | {};
if ((len > 4) && caller_perms().wizard)
  pl = args[5];
  perm = {@args, cp = caller_perms()}[6];
else
  pl = player;
  perm = cp = caller_perms();
endif
tid = this:assign();
time = (verb == "schedule_at") ? args[1] | (time() + args[1]);
iters = (verb == "schedule_every") ? 0 | 1;
INT = (verb == "schedule_every") ? args[1] | 0;
this:insert(time, tid, {iters, INT, @args[2..3], vargs, pl, perm, {time(), caller, cp, 0}});
return tid;
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

@verb #xxx:"do_checkpoint" this none this
@program #xxx:do_checkpoint
"Only use this if your server doesn't do automatic checkpoints";
if ((!caller_perms().wizard) || (!player.wizard))
  raise(E_PERM);
else
  if (this:valid_task(this.dump_task))
    this:kill_task(this.dump_task);
  endif
  this.dump_task = this:schedule(this.dump_interval, this, "do_checkpoint");
  this.checkpoint_times = (length(this.checkpoint_times) > 10) ? {@this.checkpoint_times[2..$], time()} | {@this.checkpoint_times, time()};
  starttime = time();
  for p in (connected_players())
    if (p.wizard)
      p:notify(("*** Checkpoint started " + ctime()) + ".");
    endif
  endfor
  dump_database();
  checks = 120;
  size = db_disk_size();
  try
    while (`db_disk_size() == size ! ANY => 1' && (checks > 1))
      checks = checks - 1;
      suspend(1);
    endwhile
  except v (ANY)
    "no biggie.";
  endtry
  try
    "This is a doublecheck that makes sure the db size has stabilized. If the first check was correct, only adds 2 seconds to the task.";
    size = db_disk_size();
    suspend(2);
    while (db_disk_size() != size)
      suspend(2);
      size = db_disk_size();
    endwhile
  except v (ANY)
    "no biggie.";
  endtry
  endtime = time() - starttime;
  for p in (connected_players())
    if (p.wizard)
      p:notify(((("*** Checkpoint finished " + ctime()) + ".  Elapsed time: ") + $time_utils:english_time(endtime)) + ".");
    endif
  endfor
  return this.checkpoint_sizes = (length(this.checkpoint_sizes) > 10) ? {@this.checkpoint_sizes[2..$], db_disk_size()} | {@this.checkpoint_sizes, db_disk_size()};
endif
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

@verb #xxx:"@list-ch*eckpoints" none none none rxd
@program #xxx:@list-checkpoints
"Usage:  @list-checkpoints";
"Lists the data saved for the last 10 checkpoints.";
if (this.checkpoint_times)
  player:tell("     Time             Size");
  player:tell("  -----------       --------");
  for i in [1..length(this.checkpoint_times)]
    player:tell(ctime(this.checkpoint_times[i])[5..19], "   ", $string_utils:right($string_utils:group_number(this.checkpoint_sizes[i]), 11));
  endfor
else
  player:tell("No checkpoint data.");
endif
"Last modified Wed Jan  1 19:49:59 2003 UTC by Wizard (#2).";
.

"***finished***